#!/usr/bin/perl
# Time-stamp: <2005-07-19 15:41:37 patrick>
#

#
# Takes an embl file (one per chromosome) and creates a gff and a fasta file for this 
# chromosome with all features on it. Needed as artemis does not provide correct gff files that
# can be loaded into a gff database (especially links between the chromosomes and the features
# are lost).
#

use Getopt::Long;
use strict;

use Bio::SeqIO;
use Bio::Tools::GFF;

use vars qw( $verbose $help $file );
&GetOptions( "v|verbose" => \$verbose,
	     "h|help" => \$help,
	     "f|file=s" => \$file
	     );

my $Usage =<<END_USAGE;
Usage:
    $0: [options]
Options:

    -h  --help             this message
    -v  --verbose          verbose operation
    -f  --file             embl input file (one chromosome per file)

END_USAGE

if ( $help
     || !$file ) {
    die $Usage;
}


# open EMBL chromosome file
print "Reading EMBL input file\n" if $verbose;
my $in = Bio::SeqIO->new( -file => $file,
			  -format => 'EMBL' );
my ($chrName) = $file =~ /^(.+?)\./;

my $gffFile = $chrName . ".gff";
my $fastaFile = $chrName . ".fa";

open(GFF, ">$gffFile") or die "Unable to open $gffFile, $!\n";
print GFF "##gff-version\t3\n";

# retrieve sequence object
while ( my $seq = $in->next_seq() ) {
    # overrule id in embl file.... mostly wrong anyway
    $seq->display_id($chrName);

    # create fasta file
    print "Creating fasta file for chromosome: " . $seq->display_id() . "\n" if $verbose;
    my $seqStream = Bio::SeqIO->new( -file => ">$fastaFile",
				     -format => 'fasta' );
    $seqStream->write_seq( $seq );

    print "Creating GFF file for chromosome: " . $seq->display_id() . "\n" if $verbose;

    # create gff entry for chromosome
    print GFF 
	$seq->display_id() . "\t" . 
	"EMBL/GenBank/SwissProt\tchromosome\t1\t" .
	$seq->length() . "\t" .
	".\t.\t.\t" .
	"ID=" . $seq->display_id() . ";Name=" . $seq->display_id() . "\n";

    # retrieve all features belonging to this sequence object
    my @features = $seq->get_all_SeqFeatures();

    print "Adding " . scalar(@features) . " features to gff file\n" if $verbose;
    foreach my $feature ( @features ) {
	my ($attributes, $strand, $score);	

	# associate this feature with the sequence object
	$feature->seq_id( $seq->display_id() );

	if ( $feature->has_tag('gene') ) {
	    my @geneIDs = $feature->get_tag_values('gene');
	    
	    # remove obsolete gene names from geneIDs array list
	    if ( $feature->has_tag('obsolete_name') ) {
		my @obsoleteGenes = $feature->get_tag_values('obsolete_name');
				
		foreach my $obsoleteGene ( @obsoleteGenes ) {
		    LOOP: foreach my $i ( 0 .. $#geneIDs ) {
			if ( $geneIDs[$i] eq $obsoleteGene ) {
			    # remove geneID
			    splice( @geneIDs, $i, 1 );
			    last LOOP;
			}
		    }
		}

		print "Found a feature (" . $geneIDs[$#geneIDs] . 
		    ") with obsolete names (" . join(",", @obsoleteGenes) . "), removed them\n" if $verbose;

	    }

	    # always take the last entry for the gene names ( in general this is the systematic name)
	    # ... bit of a hack...
	    $attributes = "ID=" . $geneIDs[$#geneIDs] . ";Name=" . $geneIDs[$#geneIDs] . ";gene=" . 
		join(",", @geneIDs);
	}

	# correct some values
	$score = "." if $feature->score eq '';
	$feature->frame(0);
	if ( $feature->strand == -1 ) {
	    $strand = "-";
	} elsif ( $feature->strand == 1 ) {
	    $strand = "+";
	} else {
	    $strand = ".";
	}

	# retrieve additional attributes and add them to the attributes list
	foreach my $att ( 'product', 'note' ) {
	    if ( $feature->has_tag( $att ) ) {
		my @tags = $feature->get_tag_values( $att );
		
		foreach my $tag ( @tags ) {
		    $tag =~ s/\"//g; # replace double quotes
		    $tag =~ s/ /\%20/g; # replace spaces
		    $tag =~ s/\;/\%3B/g; # replace ;
		}	    
		if ( $attributes ne '' ) {
		    $attributes .= ";" . ucfirst($att) . "=" . join(",", @tags);
		} else {
		    $attributes = ucfirst($att) . "=" . join(",", @tags);
		}
	    }
	}

	# print feature information to gff file
	print GFF 
	    $feature->seq_id . "\t" .
	    $feature->source_tag . "\t" .
	    $feature->primary_tag . "\t" .
	    $feature->start . "\t" .
	    $feature->end . "\t" .
	    $score . "\t" .
	    $strand . "\t" .
	    $feature->frame . "\t" .
	    $attributes ."\n";
    }
}

close GFF;
